home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / TCPExample / PNL Libraries / DNR.p next >
Text File  |  1996-10-10  |  8KB  |  307 lines

  1. unit DNR;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, TCPTypes;
  7.  
  8.     type
  9.         ResultProcPtr = UniversalProcPtr;
  10. { procedure ResultProc(hip:hostInfoPtr; userdata:Ptr); }
  11.         EnumResultProcPtr = UniversalProcPtr;
  12. { procedure EnumResultProc(cerp:cacheEntryRecordPtr; userdata:Ptr); }
  13.  
  14.     function OpenResolver: OSErr;
  15.     procedure CloseResolver;
  16.     function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  17.     procedure AddrToStr (addr: longint; var s: Str255);
  18.     function EnumCache (completion: EnumResultProcPtr; userdata: Ptr): OSErr;
  19.     function AddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  20.     function HInfo (host: Str255; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  21.     function MXInfo (host: Str255; var mxi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  22.  
  23. implementation
  24.  
  25.     uses
  26.         Resources, Errors, Memory, MixedMode, Files, Folders, 
  27.         MyCallProc, MyCStrings, MyMemory;
  28.  
  29.     const
  30.         kOPENRESOLVER = 1;
  31.         kCLOSERESOLVER = 2;
  32.         kSTRTOADDR = 3;
  33.         kADDRTOSTR = 4;
  34.         kENUMCACHE = 5;
  35.         kADDRTONAME = 6;
  36.         kHINFO = 7;
  37.         kMXINFO = 8;
  38.         
  39.     var
  40.         code: Handle;
  41.  
  42.     procedure GetSystemFolder (var vrn: integer; var dirID: longint);
  43.     begin
  44.         if FindFolder(kOnSystemDisk, kSystemFolderType, false, vrn, dirID) <> noErr then begin
  45.             vrn := 0;
  46.             dirID := 0;
  47.         end;
  48.     end;
  49.  
  50.     procedure GetCPanelFolder (var vrn: integer; var dirID: longint);
  51.     begin
  52.         if FindFolder(kOnSystemDisk, kControlPanelFolderType, false, vrn, dirID) <> noErr then begin
  53.             vrn := 0;
  54.             dirID := 0;
  55.         end;
  56.     end;
  57.  
  58. { SearchFolderForDNRP is called to search a folder for files that might }
  59. { contain the 'dnrp' resource }
  60.     function SearchFolderForDNRP (ftype, fcreator: OSType; vrn: integer; dirID: longint): Handle;
  61.         var
  62.             pb: HParamBlockRec;
  63.             filename: Str63;
  64.             refnum: integer;
  65.             i: integer;
  66.             hhhh: Handle;
  67.             err: OSErr;
  68.     begin
  69.         hhhh := nil;
  70.         i := 1;
  71.         repeat
  72.             pb.ioNamePtr := @filename;
  73.             pb.ioVRefNum := vrn;
  74.             pb.ioDirID := dirID;
  75.             pb.ioFDirIndex := i;
  76.             i := i + 1;
  77.             err := PBHGetFInfoSync(@pb);
  78.             if err = noErr then begin
  79.                 if (pb.ioFlFndrInfo.fdType = ftype) & (pb.ioFlFndrInfo.fdCreator = fcreator) then begin
  80.                     SetResLoad(false);
  81.                     refnum := HOpenResFile(vrn, dirID, filename, fsRdPerm);
  82.                     SetResLoad(true);
  83.                     if refnum <> -1 then begin
  84.                         hhhh := Get1IndResource('dnrp', 1);
  85.                         if hhhh <> nil then begin
  86.                             DetachResource(hhhh);
  87.                         end;
  88.                         CloseResFile(refnum);
  89.                     end;
  90.                 end;
  91.             end;
  92.         until (err <> noErr) or (hhhh <> nil);
  93.         SearchFolderForDNRP := hhhh;
  94.     end;
  95.  
  96.     function SearchForDNRP: Handle;
  97.         var
  98.             hhhh: Handle;
  99.             vrn: integer;
  100.             dirID: longint;
  101.     begin
  102. { first search Control Panels for MacTCP 1.1 }
  103.         GetCPanelFolder(vrn, dirID);
  104.         hhhh := SearchFolderForDNRP('cdev', 'ztcp', vrn, dirID);
  105.  
  106.         if hhhh = nil then begin
  107. { next search System Folder for MacTCP 1.0.x }
  108.             GetSystemFolder(vrn, dirID);
  109.             hhhh := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
  110.         end;
  111.  
  112.         if hhhh = nil then begin
  113. { then search Control Panels for MacTCP 1.0.x }
  114.             GetCPanelFolder(vrn, dirID);
  115.             hhhh := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
  116.         end;
  117.  
  118.         if hhhh = nil then begin
  119. { finally, look in any open resource file }
  120.             hhhh := Get1IndResource('dnrp', 1);
  121.             if hhhh <> nil then begin
  122.                 DetachResource(hhhh);
  123.             end;
  124.         end;
  125.  
  126.         SearchForDNRP := hhhh;
  127.     end;
  128.  
  129.     function CallOpenResolver: OSErr;
  130.         var
  131.             proc:UniversalProcPtr;
  132.     begin
  133.         proc:=New68kProc(code^,uppC244ProcInfo);
  134.         CallOpenResolver := CallC244(nil, kOPENRESOLVER,proc);
  135.         DisposeRoutineDescriptor(proc);
  136.     end;
  137.  
  138.     function OpenResolver: OSErr;
  139.         var
  140.             err: OSErr;
  141.     begin
  142.         code := SearchForDNRP;
  143.         if code = nil then begin
  144.             err := resNotFound;
  145.         end else begin
  146.             HLock(code);
  147.             err := CallOpenResolver;
  148.             if err <> noErr then begin
  149.                 MDisposeHandle(code);
  150.             end;
  151.         end;
  152.         OpenResolver := err;
  153.     end;
  154.  
  155.     function CallCloseResolver:OSErr;
  156.         var
  157.             proc:UniversalProcPtr;
  158.     begin
  159.         proc:=New68kProc(code^,uppC24ProcInfo);
  160.         CallCloseResolver := CallC24(kCLOSERESOLVER,proc);
  161.         DisposeRoutineDescriptor(proc);
  162.     end;
  163.  
  164.     procedure CloseResolver;
  165.         var
  166.             junk:OSErr;
  167.     begin
  168.         if code <> nil then begin
  169.             junk:=CallCloseResolver;
  170.             MDisposeHandle(code);
  171.         end;
  172.     end;
  173.  
  174.     function CallStrToAddr (cname: CStringPtr; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  175.         var
  176.             proc:UniversalProcPtr;
  177.     begin
  178.         proc:=New68kProc(code^,uppC244444ProcInfo);
  179.         CallStrToAddr := CallC244444(userdata,completion,@rtnStruct,cname,kSTRTOADDR,proc);
  180.         DisposeRoutineDescriptor(proc);
  181.     end;
  182.  
  183.     function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  184.         var
  185.             err: OSErr;
  186.     begin
  187.         if code = nil then begin
  188.             err := notOpenErr;
  189.         end else begin
  190.             P2C(@host);
  191.             err := CallStrToAddr(@host, rtnStruct, completion, userdata);
  192.         end;
  193.         StrToAddr := err;
  194.     end;
  195.  
  196.     function CallAddrToStr(addr: longint; cstr: CStringPtr):OSErr;
  197.         var
  198.             proc:UniversalProcPtr;
  199.     begin
  200.         proc:=New68kProc(code^,uppC2444ProcInfo);
  201.         CallAddrToStr := CallC2444(cstr, addr, kADDRTOSTR, proc);
  202.         DisposeRoutineDescriptor(proc);
  203.     end;
  204.  
  205.     procedure AddrToStr (addr: longint; var s: Str255);
  206.         var
  207.             junk:OSErr;
  208.             len: integer;
  209.     begin
  210.         if code <> nil then begin
  211.             junk := CallAddrToStr(addr, @s);
  212.             len := 0;
  213.             while (s[len] <> chr(0)) & (len < 255) do begin
  214.                 len := len + 1;
  215.             end;
  216.             BlockMoveData(@s, @s[1], len);
  217.             s[0] := chr(len);
  218.         end;
  219.     end;
  220.  
  221.     function CallEnumCache (completion: EnumResultProcPtr; userdata: Ptr): OSErr;
  222.         var
  223.             proc:UniversalProcPtr;
  224.     begin
  225.         proc:=New68kProc(code^,uppC2444ProcInfo);
  226.         CallEnumCache := CallC2444(userdata, completion, kENUMCACHE, proc);
  227.         DisposeRoutineDescriptor(proc);
  228.     end;
  229.  
  230.     function EnumCache (completion: EnumResultProcPtr; userdata: Ptr): OSErr;
  231.         var
  232.             err: OSErr;
  233.     begin
  234.         if code = nil then begin
  235.             err := notOpenErr;
  236.         end else begin
  237.             err := CallEnumCache(completion, userdata);
  238.         end;
  239.         EnumCache := err;
  240.     end;
  241.  
  242.     function CallAddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  243.         var
  244.             proc:UniversalProcPtr;
  245.     begin
  246.         proc:=New68kProc(code^,uppC244444ProcInfo);
  247.         CallAddrToName := CallC244444(userdata, completion, @hi, addr, kADDRTONAME, proc);
  248.         DisposeRoutineDescriptor(proc);
  249.     end;
  250.  
  251.     function AddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  252.         var
  253.             err: OSErr;
  254.     begin
  255.         if code = nil then begin
  256.             err := notOpenErr;
  257.         end else begin
  258.             err := CallAddrToName(addr, hi, completion, userdata);
  259.         end;
  260.         AddrToName := err;
  261.     end;
  262.  
  263.     function CallHInfo (name: CStringPtr; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  264.         var
  265.             proc:UniversalProcPtr;
  266.     begin
  267.         proc:=New68kProc(code^,uppC244444ProcInfo);
  268.         CallHInfo := CallC244444(userdata, completion, @hi, name, kHINFO, proc);
  269.         DisposeRoutineDescriptor(proc);
  270.     end;
  271.  
  272.     function HInfo (host: Str255; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  273.         var
  274.             err: OSErr;
  275.     begin
  276.         if code = nil then begin
  277.             err := notOpenErr;
  278.         end else begin
  279.             P2C(@host);
  280.             err := CallHInfo(@host, hi, completion, userdata);
  281.         end;
  282.         HInfo := err;
  283.     end;
  284.  
  285.     function CallMXInfo (name: CStringPtr; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  286.         var
  287.             proc:UniversalProcPtr;
  288.     begin
  289.         proc:=New68kProc(code^,uppC244444ProcInfo);
  290.         CallMXInfo := CallC244444(userdata, completion, @hi, name, kMXINFO, proc);
  291.         DisposeRoutineDescriptor(proc);
  292.     end;
  293.  
  294.     function MXInfo (host: Str255; var mxi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  295.         var
  296.             err: OSErr;
  297.     begin
  298.         if code = nil then begin
  299.             err := notOpenErr;
  300.         end else begin
  301.             P2C(@host);
  302.             err := CallMXInfo(@host, mxi, completion, userdata);
  303.         end;
  304.         MXInfo := err;
  305.     end;
  306.  
  307. end.